'/ I've read on several bulltinboards that unrar.dll isn't capable with vb5/6
'/ Well there wrong, I've figured out the most of important features of unrar.dll
'/
'/ You can use this to extract all files of a rararchive and unpack them to a dir
'/ of your choice, also multiple archives are allowed.
'/
'/ for the progress I had to figure out the total amount of bytes being unpack,
'/ the only stable thing I found was to test the archive first and count the bytes
'/ of each file. This testing goes quiet fast and you won't even notice it with small
'/ archive, it also check if multiple archivefiles are complete.
'/
'/ What I can't figure out (yet) is the callback, when a file is extracting from the
'/ archive the program freezes until it done. If someone has any suggestions about this
'/ please let me know.
'/
Dim udtRAR As RAROpenArchiveData
Dim lHandle As Long
Dim udtHeader As RARHeaderData
Dim lBytesCount As Long
Dim lBytesTotal As Long
Dim tmp As Long
Dim rtnRar As Long
Dim i
Public RAR_ABORT As Boolean
Const ERAR_END_ARCHIVE As Long = 10 '/ end of archive
Const ERAR_NO_MEMORY As Long = 11 '/ not enough memory to init data structures
Const ERAR_BAD_DATA As Long = 12 '/ archive header broken
Const ERAR_BAD_ARCHIVE As Long = 13 '/ not a valid rar archive
Const ERAR_UNKNOWN_FORMAT As Long = 14 '/ unknow comment format
Const ERAR_EOPEN As Long = 15 '/ file open error
Const ERAR_ECREATE As Long = 16 '/ file create error
Const ERAR_ECLOSE As Long = 17 '/ file close error
Const ERAR_EREAD As Long = 18 '/ read error
Const ERAR_EWRITE As Long = 19 '/ write error
Const ERAR_SMALL_BUF As Long = 20 '/ buffer too small, comments are not read completly
Const ERAR_NORARDLL As Long = 50 '/ Unrar.dll not found
Const RAR_OM_LIST As Long = 0 '/ open archive for reading file headers only
Const RAR_OM_EXTRACT As Long = 1 '/ open archive for testing and extracting files
Const RAR_SKIP As Long = 0 '/ move to the next file in archive
'/ if the archive is solid and RAR_OM_EXTRACT
'/ mode was set when the archive was opened,
'/ the current file will be processed - the
'/ operation will be performed slower than a
'/ single seek
Const RAR_TEST As Long = 1 '/ Test the current file and move to the next
'/ file in the archive. If the archive was opened
'/ with RAR_OM_LIST mode, the operation is equal
'/ to RAR_SKIP.
Const RAR_EXTRACT As Long = 2 '/ Extract the current file and move to the next
'/ file in the archive. If the archive was opened
'/ with RAR_OM_LIST mode, the operation is equal
'/ to RAR_SKIP
Const RAR_VOL_ASK As Long = 0 '/ Required volume is absent. The function should
'/ prompt user and return non-zero value to retry
'/ the operation. The function may also specify a
'/ new volumename, placing it to ArcName parameter.
Const RAR_VOL_NOTIFY As Long = 1 '/ Required volume is succesfully opened.
'/ This is not a notification call and ArcName
'/ modification is not allowed.
'/ The function should return non-zero value to
'/ continue or a zero-value to terminate the
'/ operation
Type RARHeaderData
ArcName As String * 260
FileName As String * 260
Flags As Long
PackSize As Long
UnpSize As Long
HostOS As Long
FileCRC As Long
FileTime As Long
UnpVer As Long
Method As Long
FileAttr As Long
CmtBuf As String
CmtBufSize As Long
CmtSize As Long
CmtState As Long
End Type
Type RAROpenArchiveData
ArcName As String
OpenMode As Long
OpenResult As Long
CmtBuf As String
CmtBufSize As Long
CmtSize As Long
CmtState As Long
End Type
Declare Function RAROpen Lib "unrar.dll" Alias "RAROpenArchive" _
(ByRef RAROpenData As RAROpenArchiveData) As Long
Declare Function RARClose Lib "unrar.dll" Alias "RARCloseArchive" _
(ByVal HandleToArchive As Long) As Long
Declare Function RARReadHdr Lib "unrar.dll" Alias "RARReadHeader" _
(ByVal HandleToArcRecord As Long, ByRef ArcHeaderRead As RARHeaderData) As Long
Declare Function RARProcFile Lib "unrar.dll" Alias "RARProcessFile" _
(ByVal HandleToArcHeader As Long, ByVal Operation As Long, ByVal DestPath As String, ByVal DestName As String) As Long
Declare Function RARSetPassword Lib "unrar.dll" _
(ByVal HandleToArchive As Long, ByVal Password As String) As Long
Declare Function RARSetChangeVolProc Lib "unrar.dll" _
(ByVal HandleToArchive As Long, ByVal mode As Long) As Long
Function ExtractRAR(sExtractDir As String, sArchName As String, lblRarFile As Label, lblRarArch As Label, lblRarProc As Label, picRarProc As PictureBox, Optional sRarPassword As String)
' check if the selected archive exists otherwise program would crash
i = Dir(sArchName)
If i = "" Then MsgBox "Archive " & sArchName & " not found!", vbCritical: Exit Function
' check if the sExtractDir end with "\"
If Right(sExtractDir, 1) <> "\" Then sExtractDir = sExtractDir & "\"
